home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyStringIDs.p < prev    next >
Text File  |  1997-06-06  |  4KB  |  175 lines
  1. unit MyStringIDs;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     type
  9.         StringID = longint;
  10.     
  11.     const
  12.         null_string_id = -1;
  13.         
  14.     procedure StartupStringIDs;
  15.     
  16.     function CreateStringID( const s: Str255; var id: StringID ): OSStatus;
  17.     procedure DestroyStringID( var id: StringID );
  18.     function GetStringID( id: StringID; var s: Str255 ): boolean;
  19.     function GetStrID( id: StringID ): Str255;
  20.     
  21. implementation
  22.  
  23.     uses
  24.         Memory, 
  25.         MyAssertions, MyStartup, MyMemory, MyLowLevel;
  26.     
  27.     type
  28.         StringIDEntry = record
  29.             id: StringID;
  30.             hash: longint;
  31.             reference_count: longint;
  32.             data: Str255; { packed, pad to 4 byte boundary }
  33.         end;
  34.         StringIDEntryPtr = ^StringIDEntry;
  35.     
  36.     const
  37.         string_id_entry_base_length = SizeOf(StringIDEntry) - 256;
  38.         
  39. {$ifc do_debug}
  40.     var
  41.         startup_check: integer;
  42. {$endc}
  43.  
  44.     var    
  45.         strings: Handle;
  46.         strings_count: longint;
  47.         current_id: longint;
  48.  
  49.     function HashString( const s:Str255 ): longint;
  50.         var
  51.             value: longint;
  52.             i: integer;
  53.     begin
  54.         value := 0;
  55.         for i := 1 to length(s) do begin
  56.             value := value * 53 + ord(s[i]);
  57.         end;
  58.         HashString := band(value, $7FFFFFFF);
  59.     end;
  60.  
  61.     function EntryLength( var entry: StringIDEntry ): longint;
  62.     begin
  63.         EntryLength := string_id_entry_base_length + ((1+length(entry.data) + 3) div 4 * 4);
  64.     end;
  65.     
  66.     function FindID( id: StringID ): StringIDEntryPtr;
  67.         var
  68.             sep: StringIDEntryPtr;
  69.             i: longint;
  70.     begin
  71.         sep := StringIDEntryPtr(strings^);
  72.         for i := 1 to strings_count do begin
  73.             if sep^.id = id then begin
  74.                 FindID := sep;
  75.                 Exit(FindID);
  76.             end;
  77.             OffsetPtr( sep, EntryLength( sep^ ) );
  78.         end;
  79.         FindID := nil;
  80.     end;
  81.     
  82.     
  83.     function CreateStringID( const s: Str255; var id: StringID ): OSStatus;
  84.         var
  85.             i: longint;
  86.             err: OSErr;
  87.             hash: longint;
  88.             sep: StringIDEntryPtr;
  89.             entry: StringIDEntry;
  90.     begin
  91.         AssertDidStartup( startup_check );
  92.         id := null_string_id;
  93.         hash := HashString( s );
  94.         sep := StringIDEntryPtr(strings^);
  95.         for i := 1 to strings_count do begin
  96.             if (sep^.hash = hash) & (sep^.data = s) then begin
  97.                 Inc(sep^.reference_count);
  98.                 id := sep^.id;
  99.                 CreateStringID := noErr;
  100.                 Exit(CreateStringID);
  101.             end;
  102.             OffsetPtr( sep, EntryLength( sep^ ) );
  103.         end;
  104.         Inc(current_id);
  105.         Assert( (FindID( current_id ) = nil) );
  106.         entry.id := current_id;
  107.         entry.hash := hash;
  108.         entry.reference_count := 1;
  109.         entry.data := s;
  110.         err := PtrAndHand( @entry, strings, EntryLength( entry ) );
  111.         if err = noErr then begin
  112.             Inc(strings_count);
  113.             id := entry.id;
  114.         end;
  115.         CreateStringID := err;
  116.     end;
  117.     
  118.     procedure DestroyStringID( var id: StringID );
  119.         var
  120.             sep: StringIDEntryPtr;
  121.     begin
  122.         AssertDidStartup( startup_check );
  123.         sep := FindID( id );
  124.         Assert( sep <> nil );
  125.         if sep <> nil then begin
  126.             Dec(sep^.reference_count);
  127.             if sep^.reference_count = 0 then begin
  128.                 MMungerDelete( strings, SubPtrPtr( sep, strings^ ), EntryLength( sep^ ) );
  129.                 Dec(strings_count);
  130.             end;
  131.         end;
  132.         id := null_string_id;
  133.     end;
  134.     
  135.     function GetStringID( id: StringID; var s: Str255 ): boolean;
  136.         var
  137.             sep: StringIDEntryPtr;
  138.     begin
  139.         AssertDidStartup( startup_check );
  140.         sep := FindID( id );
  141.         GetStringID := sep <> nil;
  142.         if sep <> nil then begin
  143.             s := sep^.data;
  144.         end else begin
  145.             s := '';
  146.         end;
  147.     end;
  148.     
  149.     function GetStrID( id: StringID ): Str255;
  150.         var
  151.             junk_boolean: boolean;
  152.             s: Str255;
  153.     begin
  154.         Assert( FindID( id ) <> nil );
  155.         junk_boolean := GetStringID( id, s );
  156.         GetStrID := s;
  157.     end;
  158.     
  159.     function InitStringIDs( var msg: integer ): OSStatus;
  160.     begin
  161. {$unused(msg)}
  162.         DidStartup( startup_check );
  163.         Assert( SizeOf( StringID ) = 4 );
  164.         strings_count := 0;
  165.         current_id := 1;
  166.         InitStringIDs := MNewHandle( strings, 0 );
  167.     end;
  168.  
  169.     procedure StartupStringIDs;
  170.     begin
  171.         SetStartup( InitStringIDs, nil, 0, nil );
  172.     end;
  173.     
  174. end.
  175.